C******  BMS, TREM, STEMUP, PBEAM ***********

	SUBROUTINE BMS
	COMMON /STF/RS(8),RSTJ2 /BM/RA,RC,RKY
	Y=RC*RSTJ2+RKY
	CALL LINES(RA,Y,2)
	END

	SUBROUTINE TREM(RH)
      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
      COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX /MIN/MINI,RMINI
      EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(J7,JQ(5)),(J9,JQ(7))
	1,(J10,JQ(8)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
	1 ,(R4,RJQ(2)),(R10,RJQ(8))

201   J7=-J7       
C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=D
      CALL NOZERO(R10)     
C  ALWAYS AT LEAST 1 IN DISPLACEMENT (AC.0)
      J10=30       
C   TO ACTIVATE PARTIAL BEAM SECTION 
      IF(J9.NE.0)GO TO 202 
C  NEXT FOR TREM. WITHOUT OTHER BEAMS.     
      RH=-1
      IF(J7.GE.20)RH=-RH   
      R5=R4+RH     
      R9=R3
      R6=R3+22.*RMINI      
202   IF(R8.EQ.0)R8=4.     
      RX=R8*RMINI*2.98     
      RH=R9+RX     
      R9=R9-RX     
	END


	SUBROUTINE STEMUP(RY,RH)
      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY        
      COMMON/POSI/STFF(0/7),JJ2,POS /MIN/MINI,RMINI
      COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,RJA
      DATA R2HGT/96.0/

C   NOW STEMS ARE UP
      RY=-RY       
C  FOR  THICKENING INCR.   
      JJ2=JJ2+10    
      RJ=-RJ       
      RJA=RMINI*R2HGT-2.*RJA       
      RJX=RJX+RJA  
      RJY=RJY+RJA  
C   POSITION 1
      R3Q=R3Q+RW   
C   POSITION 2 
      RA=RA+RW     
      RD=RD+RW     
      RH=RH+RW     
	END

	SUBROUTINE PBEAM
      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
      COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX 
      EQUIVALENCE (R6,RJQ(4)),(J8,JQ(6)),(J10,JQ(8)),(R9,RJQ(7))
	1,(R3,RJQ(1)),(R10,RJQ(8))
91	R9=R3+RX
      IF(J8.LE.-20)R9=R6-RX
      J8=-J8       
      IF(J10.EQ.0)J10=MOD(J8,10)   
      IF(J10.EQ.0)J10=1    
      R10=J10
C  IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.  
	END